home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload Trio 2
/
Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO
/
dir44
/
dungn32.zip
/
VERBS.FOR
< prev
Wrap
Text File
|
1994-10-08
|
73KB
|
2,109 lines
C Verb processors for DUNGEON
C
C COPYRIGHT 1980, 1990, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA.
C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
C WRITTEN BY R. M. SUPNIK
C
C 1-Oct-94 RMS Fixed bugs in ANSWER, INCANT, UNTIE FROM, FILL,
C GIVE, SHAKE, PLAY, POUR, POUR ON, TAKE, SPIN, BURN,
C ALARM, collectives, subcripting.
C Added COUNT, Puzzle Room entrance test.
C 11-Feb-94 RMS Fixed bug in chimney load calculation.
C 30-Jan-94 RMS Fixed bugs from MS DOS port.
C 27-Jan-94 RMS Fixed portability problem in answer array.
C 25-Jan-94 RMS Fixed bug in DIG not with shovel.
C 09-Jul-92 RMS Fixed subscript range error.
C 01-Jul-92 RMS Removed extraneous function from TAKE.
C 30-Jun-92 RMS Changed file names to lower case.
C
C VAPPLI- Main verb processing routine
C
C Declarations
C
LOGICAL FUNCTION VAPPLI(RI)
IMPLICIT INTEGER (A-Z)
INCLUDE 'dparam.for'
PARAMETER (MXNOP=39,MXJOKE=64,MXSMP=99)
PARAMETER (NUMANS=16)
LOGICAL LIT,OBJACT,WASLIT
LOGICAL QEMPTY,RMDESC,CLOCKD
LOGICAL MOVETO,YESNO
LOGICAL QOPEN,EDIBLE,DRKBLE
LOGICAL TAKE,PUT,DROP,WALK
LOGICAL QHERE,FINDXT,OAPPLI,F
INTEGER JOKES(25),ANSWER(NUMANS)
CHARACTER*12 ANSSTR(NUMANS)
CHARACTER*(WRDLNT) PW(2),CH,CH2
C
C Functions and data
C
QOPEN(R)=(OFLAG2(R).AND.OPENBT).NE.0
EDIBLE(R)=(OFLAG1(R).AND.FOODBT).NE.0
DRKBLE(R)=(OFLAG1(R).AND.DRNKBT).NE.0
DATA JOKES/4,5,3,304,305,306,307,308,309,310,311,312,
1313,5314,5319,324,325,883,884,120,120,0,0,0,0/
DATA ANSWER/0,1,2,2,3,4,4,4,4,4,5,5,5,6,7,7/
DATA ANSSTR/'TEMPLE','FOREST','30003','30,003','FLASK','RUB',
1'FONDLE','CARESS','FEEL','TOUCH','BONES','BODY',
2'SKELETON','RUSTY KNIFE','NONE','NOWHERE'/
C VAPPLI, PAGE 2
C
VAPPLI=.TRUE. ! assume wins.
ODO2=0
ODI2=0
IF((PRSO.NE.0).AND.(PRSO.LE.OMAX)) ODO2=ODESC2(PRSO)
IF(PRSI.NE.0) ODI2=ODESC2(PRSI) ! set up descriptors.
AV=AVEHIC(WINNER) ! (PRSO can be direction.)
RMK=372+RND(6) ! remark for hack-hacks.
IF(RI.EQ.0) GO TO 10 ! zero is false.
IF(RI.LE.MXNOP) RETURN ! nop?
IF(RI.LE.MXJOKE) GO TO 20 ! joke?
IF(RI.LE.MXSMP) GO TO 30 ! simple verb?
WASLIT=LIT(HERE)
GO TO (
1 500, 1000, 2000, 3000, 4000, 5000, 6000, 7000, 8000, 9000,
210000,11000,12000,13000,14000,15000,16000,17000,18000,19000,
320000,21000,22000,23000,24000,25000,26000,27000,28000,29000,
430000,31000,32000,33000,34000,35000,36000,37000,38000,39000,
540000,41000,42000,43000,44000,45000,46000,47000,48000,49000,
650000,51000,52000,53000,54000,55000,56000,57000,58000,59000,
760000,61000,62000,63000,64000,65000,66000,67000,68000,69000),
9(RI-MXSMP)
CALL BUG(7,RI)
C
C All verb processors return here to declare failure.
C
10 VAPPLI=.FALSE. ! lose.
RETURN
C
C Joke processor.
C Find proper entry in jokes, use it to select string to print.
C
20 I=JOKES(RI-MXNOP) ! get table entry.
J=I/1000 ! isolate # strings.
IF(J.NE.0) I=MOD(I,1000)+RND(J) ! if random, choose.
CALL RSPEAK(I) ! print joke.
RETURN
C
C 'Simple' verbs.
C
30 GO TO (65001,66001,67001,68001,69001,
170000,71000,72000,73000,74000,75000,76000,77000,78000,79000,
280000,81000,82000,83000,84000,85000,86000,87000,88000,89000,
390000,91000,92000,93000,94000,95000,96000,97000),
9(RI-MXJOKE)
CALL BUG(7,RI)
C
C Here to test for change in light.
C
50 IF(WASLIT.AND..NOT.LIT(HERE)) CALL RSPEAK(406)
RETURN
C VAPPLI, PAGE 3
C
C V100-- Read
C
500 IF(LIT(HERE)) GO TO 600 ! room lit?
CALL RSPEAK(356) ! no, cant read.
RETURN
C
600 IF(PRSI.EQ.0) GO TO 700 ! read through obj?
IF((OFLAG1(PRSI).AND.TRANBT).NE.0) GO TO 700
CALL RSPSUB(357,ODI2) ! not transparent.
RETURN
C
700 IF(OBJACT(X)) RETURN ! object handle?
IF((OFLAG1(PRSO).AND.READBT).NE.0) GO TO 800
CALL RSPSUB(358,ODO2) ! not readable.
RETURN
C
800 CALL RSPEAK(OREAD(PRSO)) ! print reading material.
RETURN
C
C V101-- Melt
C
1000 IF(.NOT.OBJACT(X)) CALL RSPSUB(361,ODO2)
RETURN
C
C V102-- Inflate
C
2000 IF(.NOT.OBJACT(X)) CALL RSPEAK(368) ! obj handle?
RETURN
C
C V103-- Deflate.
C
3000 IF(.NOT.OBJACT(X)) CALL RSPEAK(369) ! obj handle?
RETURN
C VAPPLI, PAGE 4
C
C V104-- Alarm
C
4000 IF((OFLAG2(PRSO).AND.VILLBT).NE.0) GO TO 4100 ! villain?
CALL RSPEAK(552+RND(6)) ! no, joke.
RETURN
C
4100 IF(.NOT.OBJACT(X)) CALL RSPSUB(370,ODO2)
RETURN
C
C V105-- Exorcise
C
5000 F=OBJACT(X) ! objects handle.
RETURN
C
C V106-- Plug
C
6000 IF(.NOT.OBJACT(X)) CALL RSPEAK(371)
RETURN
C
C V107-- Kick
C
7000 IF(.NOT.OBJACT(X)) CALL RSPSB2(378,ODO2,RMK)
RETURN
C
C V108-- Wave
C
8000 IF(.NOT.OBJACT(X)) CALL RSPSB2(379,ODO2,RMK)
RETURN
C
C V109,V110-- Raise, lower
C
9000 CONTINUE
10000 IF(.NOT.OBJACT(X)) CALL RSPSB2(380,ODO2,RMK)
RETURN
C
C V111-- Rub
C
11000 IF(.NOT.OBJACT(X)) CALL RSPSB2(381,ODO2,RMK)
RETURN
C
C V112-- Push
C
12000 IF(.NOT.OBJACT(X)) CALL RSPSB2(382,ODO2,RMK)
RETURN
C VAPPLI, PAGE 5
C
C V113-- Untie
C
13000 IF(OBJACT(X)) RETURN ! object handle?
I=383 ! no, not tied.
IF((OFLAG2(PRSO).AND.TIEBT).EQ.0) I=384 ! not tieable.
CALL RSPEAK(I)
RETURN
C
C V114-- Tie
C
14000 IF((OFLAG2(PRSO).AND.TIEBT).NE.0) GO TO 14100
CALL RSPEAK(385) ! not tieable.
RETURN
C
14100 IF(OBJACT(X)) RETURN ! object handle?
I=386 ! joke 1.
IF(PRSI.EQ.OPLAY) I=919 ! if player, joke 2.
CALL RSPSUB(386,ODO2) ! print remark.
RETURN
C
C V115-- Tie up
C
15000 IF((OFLAG2(PRSI).AND.TIEBT).NE.0) GO TO 15100
CALL RSPSUB(387,ODO2) ! not tieable.
RETURN
C
15100 I=388 ! assume villain.
IF((OFLAG2(PRSO).AND.VILLBT).EQ.0) I=389
CALL RSPSUB(I,ODO2) ! joke.
RETURN
C
C V116-- Turn
C
16000 IF((OFLAG1(PRSO).AND.TURNBT).NE.0) GO TO 16100
CALL RSPEAK(390) ! not turnable.
RETURN
C
16100 IF((OFLAG1(PRSI).AND.TOOLBT).NE.0) GO TO 16200
CALL RSPSUB(391,ODI2) ! not a tool.
RETURN
C
16200 VAPPLI=OBJACT(X) ! let object handle.
RETURN
C
C V117-- Breathe
C
17000 PRSA=INFLAW
PRSI=LUNGS
GO TO 2000 ! handle like inflate.
C VAPPLI, PAGE 5A.
C
C V118-- Knock
C
18000 IF(OBJACT(X)) RETURN ! obj handle?
I=394 ! joke for door.
IF((OFLAG1(PRSO).AND.DOORBT).EQ.0) I=395
CALL RSPSUB(I,ODO2) ! joke for nondoors too.
RETURN
C
C V119-- Look
C
19000 IF(PRSO.NE.0) GO TO 20500 ! something to look at?
VAPPLI=RMDESC(3) ! handled by rmdesc.
RETURN
C
C V120-- Examine
C
20000 IF(PRSO.NE.0) GO TO 20500 ! something to examine?
VAPPLI=RMDESC(0) ! handled by rmdesc.
RETURN
C
20500 IF(OBJACT(X)) RETURN ! obj handle?
I=OREAD(PRSO) ! get reading material.
IF(I.NE.0) CALL RSPEAK(I) ! output if there,
IF(I.EQ.0) CALL RSPSUB(429,ODO2) ! otherwise default.
PRSA=FOOW ! defuse room processors.
RETURN
C
C V121-- Shake
C
21000 IF(OBJACT(X)) RETURN ! object handle?
IF(PRSO.EQ.GWATE) GO TO 10 ! global water? fails.
IF((OFLAG2(PRSO).AND.VILLBT).EQ.0) GO TO 21100
CALL RSPEAK(371) ! joke for villains.
RETURN
C
21100 IF(PRSO.NE.AV) GO TO 21150 ! vehicle?
CALL RSPEAK(672) ! yes, joke.
RETURN
C
21150 IF((OFLAG1(PRSO).AND.TAKEBT).NE.0) GO TO 21200 ! takeable?
CALL RSPEAK(923) ! no, joke.
RETURN
C
21200 IF(OADV(PRSO).EQ.WINNER) GO TO 21250 ! carrying?
CALL RSPEAK(527) ! no, joke.
RETURN
C
21250 IF(QEMPTY(PRSO)) GO TO 10 ! empty? fails.
IF(QOPEN(PRSO)) GO TO 21300 ! open? spill.
CALL RSPSUB(396,ODO2) ! no, describe noise.
RETURN
C
21300 CALL RSPSUB(397,ODO2) ! spill the works.
DO 21500 I=1,OLNT ! spill contents.
IF(OCAN(I).NE.PRSO) GO TO 21500 ! inside?
OFLAG2(I)=OFLAG2(I).OR.TCHBT ! touch object.
IF(AV.EQ.0) GO TO 21400 ! in vehicle?
CALL NEWSTA(I,0,0,AV,0) ! yes, spill in there.
GO TO 21500
C
21400 CALL NEWSTA(I,0,HERE,0,0) ! no, spill on floor,
IF(I.EQ.WATER) CALL NEWSTA(I,133,0,0,0) ! but water disappears.
21500 CONTINUE
RETURN
C VAPPLI, PAGE 6
C
C V122-- Move
C
22000 IF(.NOT.QHERE(PRSO,HERE)) GO TO 22100 ! is it here?
IF(OBJACT(X)) RETURN ! obj handle?
I=399 ! assume not takeable.
IF((OFLAG1(PRSO).AND.TAKEBT).NE.0) I=887
CALL RSPSUB(I,ODO2) ! joke.
RETURN
C
22100 CALL RSPEAK(398) ! not here.
RETURN
C
C V123-- Turn on
C
23000 IF(OBJACT(X)) RETURN ! object handle?
IF(((OFLAG1(PRSO).AND.LITEBT).NE.0).AND.
1(OADV(PRSO).EQ.WINNER)) GO TO 23100
CALL RSPEAK(400) ! cant do it.
RETURN
C
23100 IF((OFLAG1(PRSO).AND.ONBT).EQ.0) GO TO 23200
CALL RSPEAK(401) ! already on.
RETURN
C
23200 OFLAG1(PRSO)=OFLAG1(PRSO).OR.ONBT ! turn it on.
CALL RSPSUB(404,ODO2)
RETURN
C
C V124-- Turn off
C
24000 IF(OBJACT(X)) RETURN ! obj handle?
IF(((OFLAG1(PRSO).AND.LITEBT).NE.0).AND.
1(OADV(PRSO).EQ.WINNER)) GO TO 24100
CALL RSPEAK(402) ! cant do it.
RETURN
C
24100 IF((OFLAG1(PRSO).AND.ONBT).NE.0) GO TO 24200
CALL RSPEAK(403) ! already off.
RETURN
C
24200 OFLAG1(PRSO)=OFLAG1(PRSO).AND. .NOT.ONBT
CALL RSPSUB(405,ODO2)
GO TO 50 ! go see if now dark.
C
C V125-- Open
C
25000 IF(OBJACT(X)) RETURN ! obj handle?
IF((OFLAG1(PRSO).AND.DOORBT).NE.0) GO TO 25150 ! door?
IF((OFLAG1(PRSO).AND.CONTBT).NE.0) GO TO 25100 ! container?
25050 CALL RSPSUB(407,ODO2) ! not door or container.
RETURN
C
25100 IF(OCAPAC(PRSO).NE.0) GO TO 25200 ! openable container?
25150 CALL RSPSUB(408,ODO2) ! door or not openable.
RETURN
C
25200 IF(.NOT.QOPEN(PRSO)) GO TO 25225
CALL RSPEAK(412) ! already open.
RETURN
C
25225 OFLAG2(PRSO)=OFLAG2(PRSO).OR.OPENBT ! open it.
IF(((OFLAG1(PRSO).AND.TRANBT).NE.0).OR.QEMPTY(PRSO))
1GO TO 25300
CALL PRINCO(PRSO,410,.FALSE.) ! print contents.
RETURN
C
25300 CALL RSPEAK(409) ! done
RETURN
C
C V126-- Close
C
26000 IF(OBJACT(X)) RETURN ! obj handle?
IF((OFLAG1(PRSO).AND.DOORBT).NE.0) GO TO 26050 ! door?
IF((OFLAG1(PRSO).AND.CONTBT).EQ.0) GO TO 25050 ! container?
IF(OCAPAC(PRSO).NE.0) GO TO 26100 ! closable container?
26050 CALL RSPSUB(411,ODO2) ! door or not closable.
RETURN
C
26100 IF(QOPEN(PRSO)) GO TO 26200 ! open?
CALL RSPEAK(413) ! no, joke.
RETURN
C
26200 OFLAG2(PRSO)=OFLAG2(PRSO).AND. .NOT.OPENBT
CALL RSPEAK(414) ! done.
GO TO 50 ! go see if now dark.
C VAPPLI, PAGE 7
C
C V127-- Find
C
27000 IF(OBJACT(X)) RETURN ! obj handle?
I=415 ! room string.
IF(QHERE(PRSO,HERE)) GO TO 27200 ! in room?
I=416 ! winner string.
IF(OADV(PRSO).EQ.WINNER) GO TO 27200 ! on winner?
J=OCAN(PRSO) ! down one level.
IF(J.EQ.0) GO TO 10
IF((((OFLAG1(J).AND.TRANBT).EQ.0).AND.
2(.NOT.QOPEN(J).OR.((OFLAG1(J).AND.(DOORBT+CONTBT)).EQ.0))))
3GO TO 10 ! if not visible, punt.
I=417 ! assume in room.
IF(QHERE(J,HERE)) GO TO 27100
I=418 ! assume on winner.
IF(OADV(J).NE.WINNER) GO TO 10 ! not here or on person.
27100 CALL RSPSUB(I,ODESC2(J)) ! describe findings.
RETURN
C
27200 CALL RSPSUB(I,ODO2) ! describe findings.
RETURN
C
C V128-- Wait
C
28000 CALL RSPEAK(419) ! time passes.
DO 28100 I=1,3
IF(CLOCKD(X)) RETURN
IF(.NOT.DEADF) CALL FIGHTD
IF(PRSCON.EQ.0) RETURN ! fighting happened.
28100 CONTINUE
RETURN
C
C V129-- Spin
C V159-- Turn to
C
29000 CONTINUE
59000 IF(OBJACT(X)) RETURN ! object handle?
IF((OFLAG1(PRSO).AND.TURNBT).NE.0) GO TO 59100
CALL RSPEAK(390) ! can't turn?
RETURN
C
59100 CALL RSPSUB(663,ODO2) ! won't budge.
RETURN
C
C V130-- Board
C
30000 IF((OFLAG2(PRSO).AND.VEHBT).NE.0) GO TO 30100
CALL RSPSUB(421,ODO2) ! not vehicle, joke.
PRSCON=0 ! kill cmd stream.
RETURN
C
30100 IF(QHERE(PRSO,HERE)) GO TO 30200 ! here?
CALL RSPSUB(420,ODO2) ! no, joke.
PRSCON=0 ! kill cmd stream.
RETURN
C
30200 IF(AV.EQ.0) GO TO 30300 ! already got one?
CALL RSPSUB(422,ODO2) ! yes, joke.
PRSCON=0 ! kill cmd stream.
RETURN
C
30300 IF(OBJACT(X)) RETURN ! obj handle?
CALL RSPSUB(423,ODO2) ! describe.
AVEHIC(WINNER)=PRSO
IF(WINNER.NE.PLAYER) CALL NEWSTA(AOBJ(WINNER),0,0,PRSO,0)
RETURN
C
C V131-- Disembark
C
31000 IF(AV.EQ.PRSO) GO TO 31100 ! from vehicle?
CALL RSPEAK(424) ! no, joke.
PRSCON=0 ! kill cmd stream.
RETURN
C
31100 IF(OBJACT(X)) RETURN ! obj handle?
IF((RFLAG(HERE).AND.RLAND).NE.0) GO TO 31200
CALL RSPEAK(425) ! not on land.
PRSCON=0 ! kill cmd stream.
RETURN
C
31200 AVEHIC(WINNER)=0
CALL RSPEAK(426)
IF(WINNER.NE.PLAYER) CALL NEWSTA(AOBJ(WINNER),0,HERE,0,0)
RETURN
C
C V132-- Take
C
32000 VAPPLI=TAKE(.TRUE.)
RETURN
C
C V133-- Inventory
C
33000 CALL INVENT(WINNER)
RETURN
C VAPPLI, PAGE 8
C
C V134-- Fill
C
34000 IF(PRSI.NE.0) GO TO 34050 ! any obj specified?
IF((RFLAG(HERE).AND.(RWATER+RFILL)).NE.0) GO TO 34025
CALL RSPEAK(516) ! nothing to fill with.
PRSWON=.FALSE. ! you lose.
CALL ORPHAN(-1,ACT,PREP1,PRSO,2,' ',0,0)! orphan "fill obj with"
GO TO 10 ! return false.
C
34025 PRSI=GWATE ! use global water.
34050 IF(OBJACT(X)) RETURN ! obj handle?
IF((PRSI.EQ.GWATE).OR.(PRSI.EQ.WATER)) GO TO 10
I=PRSO ! fill x with y becomes
PRSO=PRSI ! put y in x
PRSI=I
VAPPLI=PUT(.TRUE.)
RETURN
C
C V135,V136-- Eat/Drink
C
35000 CONTINUE
36000 IF(OBJACT(X)) RETURN ! obj handle?
IF(PRSO.EQ.GWATE) GO TO 36500 ! drink global water?
IF(.NOT.EDIBLE(PRSO)) GO TO 36400 ! edible?
IF(OADV(PRSO).EQ.WINNER) GO TO 36200 ! yes, on winner?
36100 CALL RSPSUB(454,ODO2) ! not accessible.
RETURN
C
36200 IF(PRSA.EQ.DRINKW) GO TO 36300 ! drink food?
CALL NEWSTA(PRSO,455,0,0,0) ! no, it disappears.
RETURN
C
36300 CALL RSPEAK(456) ! yes, joke.
RETURN
C
36400 IF(.NOT.DRKBLE(PRSO)) GO TO 36600 ! drinkable?
IF(OCAN(PRSO).EQ.0) GO TO 36100 ! yes, in something?
IF(OADV(OCAN(PRSO)).NE.WINNER) GO TO 36100
IF(QOPEN(OCAN(PRSO))) GO TO 36500 ! cont open?
CALL RSPEAK(457) ! no, joke.
RETURN
C
36500 CALL NEWSTA(PRSO,458,0,0,0) ! gone.
RETURN
C
36600 CALL RSPSUB(453,ODO2) ! not food or drink.
RETURN
C
C V137-- Burn
C
37000 IF((OFLAG1(PRSI).AND.(FLAMBT+LITEBT+ONBT)).NE.
1(FLAMBT+LITEBT+ONBT)) GO TO 37600 ! with flame?
IF(OBJACT(X)) RETURN ! obj handle?
IF((OFLAG1(PRSO).AND.BURNBT).EQ.0) GO TO 37500 ! burnable?
IF(OADV(PRSO).EQ.WINNER) GO TO 37400 ! carrying it?
IF(QHERE(PRSO,HERE)) GO TO 37200 ! here?
J=OCAN(PRSO) ! get container.
IF(J.EQ.0) GO TO 37100 ! is there one?
IF(.NOT.QOPEN(J)) GO TO 37100 ! open?
IF(J.EQ.RECEP) GO TO 37300 ! in balloon receptacle?
IF(OADV(J).EQ.WINNER) GO TO 37400 ! carrying?
IF(QHERE(J,HERE)) GO TO 37200 ! here?
37100 CALL RSPEAK(461) ! cant reach it.
RETURN
C
37200 CALL RSPSUB(462,ODO2) ! burn it.
CALL NEWSTA(PRSO,0,0,0,0)
RETURN
C
37300 VAPPLI=OAPPLI(OACTIO(BALLO),0) ! fire in receptacle.
RETURN
C
37400 CALL RSPSUB(459,ODO2) ! burnable on player.
CALL JIGSUP(460)
RETURN
C
37500 CALL RSPSUB(463,ODO2) ! cant burn it.
RETURN
C
37600 CALL RSPSUB(301,ODI2) ! cant burn it with that.
RETURN
C VAPPLI, PAGE 9
C
C V138-- Mung
C
38000 I=466 ! choose phrase.
IF((OFLAG2(PRSO).AND.VILLBT).NE.0) GO TO 41100
IF(.NOT.OBJACT(X)) CALL RSPSB2(466,ODO2,RMK)
RETURN
C
C V139-- Kill
C
39000 I=467 ! choose phrase.
GO TO 41100
C
C V140-- Swing
C
40000 J=PRSO ! invert.
PRSO=PRSI
PRSI=J
J=ODO2
ODO2=ODI2
ODI2=J
PRSA=ATTACW ! for objact.
C
C V141-- Attack
C
41000 I=468
C
C Common mung/attack/swing/kill code.
C
41100 IF(PRSO.NE.0) GO TO 41200 ! anything?
CALL RSPEAK(469) ! no, joke.
RETURN
C
41200 IF(OBJACT(X)) RETURN ! obj handle?
IF((OFLAG2(PRSO).AND.VILLBT).NE.0) GO TO 41300
IF((OFLAG1(PRSO).AND.VICTBT).EQ.0)
1CALL RSPSUB(470,ODO2) ! not a villain.
RETURN
C
41300 J=471 ! assume no weapon.
IF(PRSI.EQ.0) GO TO 41500
IF((OFLAG2(PRSI).AND.WEAPBT).EQ.0) GO TO 41400
MELEE=1 ! assume sword.
IF(PRSI.NE.SWORD) MELEE=2 ! must be knife.
I=BLOW(PLAYER,PRSO,MELEE,.TRUE.,0) ! strike blow.
RETURN
C
41400 J=472 ! not a weapon.
41500 CALL RSPSB2(I,ODO2,J) ! joke.
RETURN
C VAPPLI, PAGE 10
C
C V142-- Walk
C
42000 VAPPLI=WALK(X)
RETURN
C
C V143-- Tell
C
43000 CALL RSPEAK(603)
PRSCON=0 ! kill cmd stream.
RETURN
C
C V144-- Put
C
44000 VAPPLI=PUT(.TRUE.)
RETURN
C
C V145,V148-- Drop/Throw
C
45000 CONTINUE ! throw.
48000 VAPPLI=DROP(.TRUE.) ! drop.
RETURN
C
C V146-- Give
C
46000 IF(OADV(PRSO).EQ.WINNER) GO TO 46100 ! is he carrying obj?
X=OCAN(PRSO) ! get container.
IF(X.EQ.0) GO TO 46200 ! container?
IF(.NOT.QOPEN(X)) GO TO 46200 ! open?
IF(OADV(X).NE.WINNER) GO TO 46200 ! carrying?
46100 VAPPLI=OBJACT(X) ! iobject must handle.
RETURN
C
46200 CALL RSPEAK(527) ! don't have it.
RETURN
C
C V147-- Pour
C
47000 IF(PRSO.EQ.WATER) GO TO 47100 ! pour? must be water.
CALL RSPEAK(1075) ! otherwise, joke.
RETURN
C
47100 IF(PRSI.EQ.0) GO TO 48000 ! pour x, treat like drop.
PRSA=PUTW ! else, treat like put.
VAPPLI=PUT(.TRUE.)
RETURN
C
C V149-- Save
C
49000 IF((RFLAG(TSTRS).AND.RSEEN).EQ.0) GO TO 49100
CALL RSPEAK(828) ! no saves in endgame.
RETURN
C
49100 CALL SAVEGM ! save game.
PRSWON=.FALSE. ! disable rest of move.
PRSCON=0
RETURN
C
C V150-- Restore
C
50000 IF((RFLAG(TSTRS).AND.RSEEN).EQ.0) GO TO 50100
CALL RSPEAK(829) ! no restores in endgame.
RETURN
C
50100 CALL RSTRGM ! restore game.
PRSWON=.FALSE. ! disable rest of move.
PRSCON=0
RETURN
C VAPPLI, PAGE 11
C
C V151-- Hello
C
51000 IF(PRSO.NE.0) GO TO 51100 ! any obj?
CALL RSPEAK(346+RND(4)) ! no, vanilla hello.
RETURN
C
51100 IF(PRSO.NE.AVIAT) GO TO 51200 ! hello aviator?
CALL RSPEAK(350) ! nothing happens.
RETURN
C
51200 IF(PRSO.NE.SAILO) GO TO 51300 ! hello sailor?
HS=HS+1 ! count.
I=351 ! give normal or
IF(MOD(HS,10).EQ.0) I=352 ! random message.
IF(MOD(HS,20).EQ.0) I=353
CALL RSPEAK(I) ! speak up.
RETURN
C
51300 IF(OBJACT(X)) RETURN ! obj handle?
I=354 ! assume villain.
IF((OFLAG2(PRSO).AND.(VILLBT+ACTRBT)).EQ.0) I=355
CALL RSPSUB(I,ODO2) ! hello there!
RETURN
C
C V152-- Look into
C
52000 IF(OBJACT(X)) RETURN ! obj handle?
IF((OFLAG1(PRSO).AND.DOORBT).EQ.0) GO TO 52300 ! door?
IF(.NOT.QOPEN(PRSO)) GO TO 52200 ! open?
CALL RSPSUB(628,ODO2) ! open door- uninteresting.
RETURN
C
52200 CALL RSPSUB(525,ODO2) ! closed door- cant see.
RETURN
C
52300 IF((OFLAG1(PRSO).AND.CONTBT).NE.0) GO TO 52500 ! container?
IF(QOPEN(PRSO)) GO TO 52400 ! open anyway?
CALL RSPSUB(630,ODO2) ! cant look inside.
RETURN
C
52400 IF(.NOT.QEMPTY(PRSO)) GO TO 52700 ! not empty?
CALL RSPSUB(1054,ODO2) ! doesn't contain anything.
RETURN
C
52500 IF(QOPEN(PRSO).OR.((OFLAG1(PRSO).AND.TRANBT).NE.0))
1GO TO 52600 ! open or see inside?
CALL RSPSUB(525,ODO2) ! closed.
RETURN
C
52600 IF(QEMPTY(PRSO)) GO TO 52800 ! see in. empty?
52700 CALL PRINCO(PRSO,573,.TRUE.) ! no, list contents.
RETURN
C
52800 CALL RSPSUB(629,ODO2) ! empty.
RETURN
C VAPPLI, PAGE 12
C
C V153-- Look under
C
53000 IF(.NOT.OBJACT(X)) CALL RSPEAK(631) ! object handle?
RETURN
C
C V154-- Pump
C
54000 IF((OROOM(PUMP).EQ.HERE).OR.(OADV(PUMP).EQ.WINNER))
1GO TO 54100 ! pump here?
CALL RSPEAK(632) ! no.
RETURN
C
54100 PRSI=PUMP ! becomes inflate
PRSA=INFLAW ! x with pump.
GO TO 2000 ! done.
C
C V155-- Wind
C
55000 IF(.NOT.OBJACT(X)) CALL RSPSUB(634,ODO2) ! obj handle?
RETURN
C
C V156-- Climb
C V157-- Climb up
C V158-- Climb down
C
56000 CONTINUE
57000 CONTINUE
58000 IF(OBJACT(X)) RETURN ! object handle?
I=XUP ! assume up.
IF(PRSA.EQ.CLMBDW) I=XDOWN ! unless climb dn.
F=(OFLAG2(PRSO).AND.CLMBBT).NE.0
IF(F.AND.FINDXT(I,HERE)) GO TO 58500 ! anything to climb?
I=657
IF(F) I=524 ! variety of jokes.
IF(.NOT.F .AND.((PRSO.EQ.WALL).OR.(PRSO.EQ.GRWAL).OR.
1((PRSO.GE.WNORT).AND.(PRSO.LE.WNORT+3))))
2I=656 ! if walls.
CALL RSPEAK(I) ! joke.
RETURN
C
58500 PRSA=WALKW ! walk
PRSO=I ! in specified dir.
GO TO 42000 ! treat as walk.
C VAPPLI, PAGE 13
C
C V160-- Pour on
C
60000 IF(PRSO.NE.WATER) GO TO 60500 ! pour water?
IF(OBJACT(X)) RETURN ! object handle?
CALL NEWSTA(WATER,0,0,0,0) ! vanish water.
IF(OCAN(PRSI).NE.RECEP) GO TO 60100 ! onto obj in receptacle?
CALL RSPSUB(977,ODI2) ! doesn't work.
RETURN
C
60100 IF((OFLAG1(PRSI).AND.(LITEBT+FLAMBT+ONBT)).NE.
1(LITEBT+FLAMBT+ONBT)) GO TO 60300 ! on flame?
IF(PRSI.NE.TORCH) GO TO 60200 ! on torch?
CALL RSPEAK(978) ! doesn't work.
RETURN
C
60200 OFLAG1(PRSI)=OFLAG1(PRSI).AND..NOT.ONBT ! extinguish.
CALL RSPSUB(979,ODI2) ! describe.
IF(PRSI.EQ.CANDL) CFLAG(CEVCND)=.FALSE. ! if candle, disable timer.
IF(PRSI.EQ.MATCH) CTICK(CEVMAT)=0 ! if match, gone.
GO TO 50 ! go see if now dark.
C
60300 CALL RSPSUB(980,ODI2) ! doesn't work.
RETURN
C
60500 CALL RSPEAK(981) ! not water, joke.
RETURN
C
C V161-- Put under
C
61000 IF(OBJACT(X)) RETURN ! object handle.
I=1037 ! can't do.
IF((OFLAG1(PRSO).AND.DOORBT).NE.0) I=982 ! if door, won't fit.
CALL RSPEAK(I)
RETURN
C
C V162-- Untie from
C
62000 IF(((PRSO.EQ.BROPE).AND.(BTIEF.NE.0)).OR.
1 ((PRSO.EQ.ROPE).AND.(TTIE.EQ.PRSI)).OR.
2 ((PRSO.EQ.ROPE).AND.(PRSI.EQ.RAILI).AND.DOMEF))
3 GO TO 62100 ! untie rope?
CALL RSPEAK(1070) ! not attached to that.
RETURN
C
62100 PRSA=UNTIEW ! treat as normal untie.
GO TO 13000
C VAPPLI, PAGE 14
C
C V163-- Make
C V169-- Wish
C
63000 IF(PRSO.NE.GWISH) GO TO 10 ! make a wish?
69000 IF(HERE.NE.BWELL) GO TO 63100 ! at well?
IF(OROOM(BAGCO).EQ.HERE) GO TO 63200 ! coins here?
IF(OROOM(ZORKM).EQ.HERE) GO TO 63300 ! zorkmid here?
63100 CALL RSPEAK(937) ! doesn't work.
RETURN
C
63200 CALL NEWSTA(BAGCO,938,0,0,0) ! vanish coins
RETURN
C
63300 CALL NEWSTA(ZORKM,938,0,0,0) ! vanish zorkmid.
RETURN
C
C V164-- Oil
C
64000 IF(PRSI.NE.PUTTY) GO TO 64100 ! with putty?
IF(OBJACT(X)) RETURN ! object handle?
CALL RSPEAK(904) ! doesn't work.
RETURN
C
64100 CALL RSPEAK(905) ! joke.
RETURN
C
C V165-- Play
C
65000 IF(PRSO.NE.STRAD) GO TO 65200 ! play violin?
IF(PRSI.EQ.0) GO TO 65100 ! with anything?
IF((OFLAG2(PRSI).AND.WEAPBT).EQ.0) GO TO 65100
OTVAL(STRAD)=0 ! with weapon, ruined.
CALL RSPEAK(933)
RETURN
C
65100 CALL RSPEAK(934) ! offensive noise.
RETURN
C
65200 IF((OFLAG2(PRSO).AND.VILLBT).EQ.0) GO TO 10 ! play villain?
CALL RSPSUB(935,ODO2) ! you're dead.
CALL JIGSUP(0)
RETURN
C
C V166-- Send
C
66000 IF(OBJACT(X)) RETURN ! object handle?
I=940 ! can't do it.
IF((OFLAG2(PRSO).AND.VILLBT).NE.0) I=941 ! why do it?
CALL RSPSUB(I,ODO2)
RETURN
C VAPPLI, PAGE 15
C
C V167-- Enter
C
67000 PRSA=WALKW ! treat as walk.
PRSO=XENTER
GO TO 42000
C
C V168-- Leave
C
68000 PRSA=WALKW ! treat as walk.
PRSO=XEXIT
GO TO 42000
C
C V65-- Room
C
65001 VAPPLI=RMDESC(2) ! describe room only.
RETURN
C
C V66-- Objects
C
66001 VAPPLI=RMDESC(1) ! describe obj only.
IF(.NOT.TELFLG) CALL RSPEAK(138) ! no objects.
RETURN
C
C V67-- Rname
C
67001 CALL RSPEAK(RDESC2-HERE) ! short room name.
RETURN
C
C V68-- Squeeze
C
68001 IF(OBJACT(X)) RETURN ! object handle?
I=901 ! can't.
IF((OFLAG2(PRSO).AND.VILLBT).NE.0) I=902 ! don't understand.
CALL RSPSUB(I,ODO2)
RETURN
C
C V69-- Smell
C
69001 CALL RSPSUB(903,ODO2) ! joke.
RETURN
C VAPPLI, PAGE 16
C
C V70-- Brief
C
70000 BRIEFF=.TRUE. ! brief descriptions.
SUPERF=.FALSE.
CALL RSPEAK(326)
RETURN
C
C V71-- Verbose
C
71000 BRIEFF=.FALSE. ! long descriptions.
SUPERF=.FALSE.
CALL RSPEAK(327)
RETURN
C
C V72-- Superbrief
C
72000 SUPERF=.TRUE.
CALL RSPEAK(328)
RETURN
C
C V73-- Stay (used in endgame)
C
73000 IF(WINNER.NE.AMASTR) GO TO 73100 ! tell master, stay.
CALL RSPEAK(781) ! he does.
CTICK(CEVFOL)=0 ! not following.
RETURN
C
73100 IF(WINNER.EQ.PLAYER) CALL RSPEAK(664) ! joke.
RETURN
C
C V74-- Version
C
74000 WRITE(OUTCH,74010) VMAJ,VMIN,VEDIT
74010 FORMAT(' V',I1,'.',I1,A)
TELFLG=.TRUE.
RETURN
C
C V75-- Swim
C
75000 I=330 ! assume water.
IF((RFLAG(HERE).AND.(RWATER+RFILL)).EQ.0)
1I=331+RND(3) ! if no water, joke.
CALL RSPEAK(I)
RETURN
C
C V76-- Geronimo
C
76000 IF(AVEHIC(WINNER).EQ.BARRE) GO TO 76100 ! in barrel?
CALL RSPEAK(334) ! no, joke.
RETURN
C
76100 CALL JIGSUP(335) ! over falls.
RETURN
C
C V77-- Sinbad et al
C
77000 IF((HERE.EQ.MCYCL).AND.(OROOM(CYCLO).EQ.HERE)) GO TO 77100
CALL RSPEAK(336) ! not here, joke.
RETURN
C
77100 CALL NEWSTA(CYCLO,337,0,0,0) ! cyclops flees.
CYCLOF=.TRUE. ! set all flags.
MAGICF=.TRUE.
OFLAG2(CYCLO)=OFLAG2(CYCLO).AND. .NOT.FITEBT
RETURN
C
C V78-- unused
C
78000 GO TO 10
C
C V79-- Pray
c
79000 IF(HERE.NE.TEMP2) GO TO 79050 ! in temple?
IF(MOVETO(FORE1,WINNER)) GO TO 79100 ! fore1 still there?
79050 CALL RSPEAK(340) ! joke.
RETURN
C
79100 F=RMDESC(3) ! moved, describe.
RETURN
C
C V80-- Treasure
c
80000 IF(HERE.NE.TEMP1) GO TO 80050 ! in temple?
IF(MOVETO(TREAS,WINNER)) GO TO 79100 ! treasure room there?
80050 CALL RSPEAK(341) ! nothing happens.
RETURN
C
C V81-- Temple
c
81000 IF(HERE.NE.TREAS) GO TO 81050 ! in treasure?
IF(MOVETO(TEMP1,WINNER)) GO TO 79100 ! temp1 still there?
81050 CALL RSPEAK(341) ! nothing happens.
RETURN
C
C V82-- Blast
C
82000 I=342 ! dont understand.
IF(PRSO.EQ.SAFE) I=252 ! joke for safe.
CALL RSPEAK(I)
RETURN
C
C V83-- Score
C
83000 CALL SCORE(.FALSE.)
RETURN
C
C V84-- Quit
C
84000 CALL SCORE(.TRUE.) ! tell score.
IF(.NOT.YESNO(343,10,0)) RETURN ! ask for y/n decision.
STOP ' ' ! bye.
C VAPPLI, PAGE 17
C
C V85-- Follow (used in endgame)
C
85000 IF(WINNER.NE.AMASTR) GO TO 85100 ! tell master, follow.
CALL RSPEAK(782)
CFLAG(CEVFOL)=.TRUE.
CTICK(CEVFOL)=-1 ! starts following.
RETURN
C
85100 I=10 ! assume ok.
IF(PRSO.EQ.0) GO TO 85200 ! any object?
I=964 ! joke 1
IF((OFLAG2(PRSO).AND.VILLBT).NE.0) I=965 ! joke 2.
85200 CALL RSPEAK(I)
RETURN
C
C V86-- Walk through
C
86000 IF(OBJACT(X)) RETURN ! object handle?
IF((SCOLRM.EQ.0).OR.((PRSO.NE.SCOL).AND.
1((PRSO.NE.WNORT).OR.(HERE.NE.BKBOX)))) GO TO 86100
SCOLAC=SCOLRM ! walked thru scol.
PRSO=0 ! fake out fromdr.
CFLAG(CEVSCL)=.TRUE.
CTICK(CEVSCL)=6 ! start alarm.
CALL RSPEAK(668) ! disorient him.
F=MOVETO(SCOLRM,WINNER) ! into room.
F=RMDESC(0) ! describe.
RETURN
C
86100 IF(HERE.NE.SCOLAC) GO TO 86300 ! on other side of scol?
DO 86200 I=1,12,3 ! walk thru proper wall?
IF((SCOLWL(I).EQ.HERE).AND.(SCOLWL(I+1).EQ.PRSO))
1GO TO 86500 ! in specified room?
86200 CONTINUE
C
86300 IF((OFLAG1(PRSO).AND.TAKEBT).NE.0) GO TO 86400 ! tkble?
I=669 ! no, joke.
IF(PRSO.EQ.SCOL) I=670 ! special joke for scol.
CALL RSPSUB(I,ODO2)
RETURN
C
86400 I=671 ! joke.
IF(OROOM(PRSO).NE.0) I=552+RND(6) ! special jokes if carry.
CALL RSPEAK(I)
RETURN
C
86500 PRSO=SCOLWL(I+2) ! thru scol wall...
DO 86600 I=1,8,2 ! find matching room.
IF(PRSO.EQ.SCOLDR(I)) SCOLRM=SCOLDR(I+1)
86600 CONTINUE ! declare new scolrm.
CTICK(CEVSCL)=0 ! cancel alarm.
CALL RSPEAK(668) ! disorient him.
F=MOVETO(BKBOX,WINNER) ! back in box room.
F=RMDESC(0)
RETURN
C
C V87-- Ring
C
87000 IF(OBJACT(X)) RETURN ! object handle?
I=359 ! cant ring.
IF(PRSO.EQ.BELL) I=360 ! ding, dong.
CALL RSPEAK(I) ! joke.
RETURN
C
C V88-- Brush
C
88000 IF(PRSO.EQ.TEETH) GO TO 88100 ! brush teeth?
CALL RSPEAK(362) ! no, joke.
RETURN
C
88100 IF(PRSI.NE.0) GO TO 88200 ! with something?
CALL RSPEAK(363) ! no, joke.
RETURN
C
88200 IF((PRSI.EQ.PUTTY).AND.(OADV(PUTTY).EQ.WINNER))
1GO TO 88300 ! with putty?
CALL RSPSUB(364,ODI2) ! no, joke.
RETURN
C
88300 CALL JIGSUP(365) ! yes, dead!!!!!
RETURN
C VAPPLI, PAGE 18
C
C V89-- Dig
C
89000 IF(PRSI.NE.SHOVE) GO TO 89100 ! shovel?
VAPPLI=OBJACT(X) ! must handle.
RETURN
C
89100 I=392 ! assume tool.
IF((OFLAG1(PRSI).AND.TOOLBT).EQ.0) I=393
CALL RSPSUB(I,ODI2)
RETURN
C
C V90-- Time
C
90000 CALL GTTIME(K) ! get play time.
I=K/60
J=MOD(K,60)
WRITE(OUTCH,90010)
IF(I.NE.0) WRITE(OUTCH,90011) I
IF(I.GE.2) WRITE(OUTCH,90012)
IF(I.EQ.1) WRITE(OUTCH,90013)
IF(J.EQ.1) WRITE(OUTCH,90014) J
IF(J.NE.1) WRITE(OUTCH,90015) J
TELFLG=.TRUE.
RETURN
C
90010 FORMAT(' You have been playing Dungeon for ',$)
90011 FORMAT('+',I3,' hour',$)
90012 FORMAT('+s and ',$)
90013 FORMAT('+ and ',$)
90014 FORMAT('+',I2,' minute.')
90015 FORMAT('+',I2,' minutes.')
C
C V91-- Leap
C
91000 IF(PRSO.EQ.0) GO TO 91200 ! over something?
IF(QHERE(PRSO,HERE)) GO TO 91100 ! here?
CALL RSPEAK(447) ! no, joke.
RETURN
C
91100 IF((OFLAG2(PRSO).AND.VILLBT).EQ.0) GO TO 91300
CALL RSPSUB(448,ODO2) ! cant jump villain.
RETURN
C
91200 IF(.NOT.FINDXT(XDOWN,HERE)) GO TO 91300 ! down exit?
IF(XTYPE.EQ.XNO) GO TO 91400 ! invalid?
IF(XTYPE.NE.XCOND) GO TO 91300 ! conditional?
IF(.NOT.FLAGS(XFLAG)) GO TO 91400 ! blocked off?
91300 CALL RSPEAK(314+RND(5)) ! wheeee!
RETURN
C
91400 IF(WINNER.EQ.PLAYER) GO TO 91500 ! tell x, jump?
CALL JIGSUP(452) ! Geronimo!
RETURN
C
91500 CALL JIGSUP(449+RND(4)) ! fatal leap.
RETURN
C VAPPLI, PAGE 19
C
C V92-- Lock
C
92000 IF(OBJACT(X)) RETURN ! object handle?
IF((PRSO.EQ.GRATE).AND..NOT.QOPEN(GRATE).AND.(HERE.EQ.MGRAT))
1GO TO 92200 ! lock closed grate?
92100 CALL RSPEAK(464) ! not lock grate.
RETURN
C
92200 GRUNLF=.FALSE. ! grate now locked.
CALL RSPEAK(214)
TRAVEL(REXIT(HERE)+1)=214 ! change exit status.
RETURN
C
C V93-- Unlock
C
93000 IF(OBJACT(X)) RETURN ! object handle?
IF((PRSO.NE.GRATE).OR.(HERE.NE.MGRAT))
1GO TO 92100 ! not unlock grate.
IF(PRSI.EQ.KEYS) GO TO 93200 ! got keys?
CALL RSPSUB(465,ODI2) ! no, joke.
RETURN
C
93200 GRUNLF=.TRUE. ! unlock grate.
CALL RSPEAK(217)
TRAVEL(REXIT(HERE)+1)=1041 ! change exit status.
RETURN
C
C V94-- Diagnose
C
94000 I=FIGHTS(WINNER,.FALSE.) ! get fights strength.
J=ASTREN(WINNER) ! get health.
K=MIN0(I+J,4) ! get state.
IF(.NOT.CFLAG(CEVCUR)) J=0 ! if no wounds.
L=MIN0(4,IABS(J)) ! scale.
CALL RSPEAK(473+L) ! describe health.
I=(30*(-J-1))+CTICK(CEVCUR) ! compute wait.
IF(J.NE.0) WRITE(OUTCH,94100) I
94100 FORMAT(' You will be cured after ',I3,' moves.')
CALL RSPEAK(478+K) ! how much more?
IF(DEATHS.NE.0) CALL RSPEAK(482+DEATHS) ! how many deaths?
RETURN
C VAPPLI, PAGE 20
C
C V95-- Incant
C
95000 IF(WINNER.NE.PLAYER) GO TO 10 ! must do yourself.
IF((RFLAG(MREYE).AND.RSEEN).NE.0) GO TO 95800 ! too late?
IF(SUBLNT.EQ.0) GO TO 95350 ! any input?
PW(1)=' ' ! set up parse.
PW(2)=' '
WP=1
CP=1
DO 95200 I=1,SUBLNT ! scan substring
IF(SUBBUF(I:I).NE.' ') GO TO 95150 ! blank?
IF(CP.EQ.1) GO TO 95200 ! anything in word yet?
WP=MIN0(2,WP+1) ! advance word pointer.
CP=1 ! reset char pointer.
GO TO 95200
95150 IF(CP.LE.WRDLNT) PW(WP)(CP:CP)=SUBBUF(I:I) ! add char to word.
CP=CP+1
95200 CONTINUE
C
IF(PW(1).NE.' ') GO TO 95400 ! any input?
95350 CALL RSPEAK(856) ! no, ho hum.
95375 PRSCON=0 ! kill cmd stream.
RETURN
C
95400 CALL ENCRYP(PW(1),CH) ! compute response.
IF(PW(2).NE.' ') GO TO 95600 ! two phrases?
C
IF(SPELLF) GO TO 95550 ! he's trying to learn.
IF((RFLAG(TSTRS).AND.RSEEN).EQ.0) GO TO 95575 ! really in end game?
SPELLF=.TRUE. ! tell him.
TELFLG=.TRUE.
WRITE(OUTCH,95510) PW(1)(1:NBLEN(PW(1))),CH
95510 FORMAT(' A hollow voice replies: "',A,1X,A,'".')
RETURN
C
95550 CALL RSPEAK(857) ! he's got one already.
GO TO 95375
C
95575 CALL RSPEAK(858) ! he's not in endgame.
GO TO 95375
C
95600 CALL ENCRYP(PW(2),CH2) ! try both ways.
IF(SPELLF.OR.((PW(1).NE.CH2).AND.(PW(2).NE.CH)))
1 GO TO 95900 ! wrong or second use.
SPELLF=.TRUE. ! it works.
CALL RSPEAK(859)
CFLAG(CEVSTE)=.TRUE.
CTICK(CEVSTE)=1 ! force start.
RETURN
C
95800 CALL RSPEAK(855) ! too late.
GO TO 95375
C
95900 CALL RSPEAK(1052) ! got it wrong.
GO TO 95375
C VAPPLI, PAGE 21
C
C V96-- Answer
C
96000 IF(WINNER.NE.PLAYER) GO TO 10 ! must answer for himself.
IF(SUBLNT.EQ.0) GO TO 96050 ! any substring?
IF((HERE.EQ.RIDDL).AND..NOT.RIDDLF) GO TO 96700 ! riddle room?
IF(HERE.EQ.FDOOR) GO TO 96100 ! end game front door?
96050 CALL RSPEAK(799) ! no one listens.
PRSCON=0 ! kill cmd stream.
RETURN
C
96100 IF(INQSTF.AND.(NQATT.LT.5).AND.(CORRCT.LT.3))
1GO TO 96200 ! knocked, didn't lose or win?
CALL RSPEAK(783) ! no reply.
PRSCON=0 ! kill cmd stream.
RETURN
C
96200 DO 96300 J=1,NUMANS ! check answers.
IF(QUESNO.NE.ANSWER(J)) GO TO 96300 ! only check proper ans.
IF(SUBBUF.EQ.ANSSTR(J)(1:NBLEN(ANSSTR(J)))) GO TO 96500
96300 CONTINUE
C
PRSCON=0 ! kill cmd stream.
NQATT=NQATT+1 ! wrong, cretin.
IF(NQATT.GE.5) GO TO 96400 ! too many wrong?
CALL RSPEAK(800+NQATT) ! no, try again.
RETURN
C
96400 CALL RSPEAK(826) ! all over.
CFLAG(CEVINQ)=.FALSE. ! lose.
RETURN
C
96500 CORRCT=CORRCT+1 ! got it right.
CALL RSPEAK(800) ! hooray.
IF(CORRCT.GE.3) GO TO 96600 ! won totally?
CFLAG(CEVINQ)=.TRUE.
CTICK(CEVINQ)=2 ! no, start again.
QUESNO=MOD(QUESNO+3,8)
NQATT=0
CALL RSPEAK(769) ! ask next question.
CALL RSPEAK(770+QUESNO)
RETURN
C
96600 CALL RSPEAK(827) ! quiz over,
CFLAG(CEVINQ)=.FALSE.
OFLAG2(QDOOR)=OFLAG2(QDOOR).OR.OPENBT ! open door.
RETURN
C
96700 IF(SUBBUF.NE.'WELL') GO TO 96050 ! right answer?
RIDDLF=.TRUE. ! solved riddle.
CALL RSPEAK(338)
RETURN
C V97-- Count (valuables, possessions in VALUAC)
C
97000 IF(PRSO.NE.MATCH) GO TO 97100 ! matches?
IF(ORMTCH.EQ.1) WRITE(OUTCH,97010) ORMTCH ! print number.
IF(ORMTCH.NE.1) WRITE(OUTCH,97020) ORMTCH
97010 FORMAT(' You have ',I1,' match.')
97020 FORMAT(' You have ',I1,' matches.')
TELFLG=.TRUE.
RETURN
C
97100 I=1062 ! default.
IF(PRSO.EQ.BAGCO) I=561 ! bag of coins.
IF(PRSO.EQ.CANDL) I=1058 ! candles.
IF(PRSO.EQ.BILLS) I=1059 ! stack of bills.
IF(PRSO.EQ.LEAVE) I=1060 ! pile of leaves.
IF(PRSO.EQ.GWISH) I=1061 ! blessings.
IF(PRSO.EQ.HEADS) I=1084 ! heads.
CALL RSPEAK(I) ! print response.
RETURN
C
END
C TAKE-- Basic take sequence
C
C Take an object (for verbs take, put, drop, read, etc.)
C
LOGICAL FUNCTION TAKE(FLG)
C
C Declarations
C
IMPLICIT INTEGER (A-Z)
LOGICAL FLG,OBJACT,OAPPLI,QHERE
INCLUDE 'dparam.for'
C TAKE, PAGE 2
C
IF((PRSO.LE.STRBIT).AND.
1((OFLAG2(PRSO).AND.NOCHBT).EQ.0)) GO TO 100 ! star or nocheck?
TAKE=OBJACT(X) ! yes, let it handle.
RETURN
C
100 TAKE=.FALSE. ! assume loses.
X=OCAN(PRSO) ! inside?
IF((PRSI.EQ.0).OR.(PRSI.EQ.X)) GO TO 200 ! take x from ocan(x)?
CALL RSPEAK(1038) ! not in that.
RETURN
C
200 IF(PRSO.NE.AVEHIC(WINNER)) GO TO 400 ! his vehicle?
CALL RSPEAK(672) ! dummy.
RETURN
C
400 IF((OFLAG1(PRSO).AND.TAKEBT).NE.0) GO TO 500 ! takeable?
IF(.NOT.OAPPLI(OACTIO(PRSO),0)) CALL RSPEAK(552+RND(6))
RETURN
C
C Object is takeable and in position to be taken.
C
500 IF((X.NE.0).OR. QHERE(PRSO,HERE)) GO TO 600
I=103 ! assume player.
IF(WINNER.NE.PLAYER) I=1080
IF(OADV(PRSO).EQ.WINNER) CALL RSPEAK(I) ! already got it?
RETURN
C
600 IF(X.EQ.0) GO TO 650 ! contained?
IF(OADV(X).EQ.WINNER) GO TO 700 ! already carrying cont?
650 IF((WEIGHR(PRSO,WINNER)+OSIZE(PRSO)).LE.MXLOAD)
2GO TO 700 ! can he carry?
I=558 ! assume player.
IF(WINNER.NE.PLAYER) I=1079
CALL RSPEAK(I) ! too much weight.
PRSCON=0 ! kill cmd stream.
RETURN
C
700 TAKE=.TRUE. ! at last.
IF(OAPPLI(OACTIO(PRSO),0)) RETURN ! did it handle?
CALL NEWSTA(PRSO,0,0,0,WINNER) ! take object for winner.
OFLAG2(PRSO)=OFLAG2(PRSO).OR.TCHBT ! has been touched.
CALL SCRUPD(OFVAL(PRSO)) ! update score.
OFVAL(PRSO)=0 ! cant be scored again.
IF(FLG) CALL RSPEAK(559) ! tell taken.
RETURN
C
END
C DROP- Drop verb processor (also throw, pour water)
C
C Declarations
C
LOGICAL FUNCTION DROP(FLG)
IMPLICIT INTEGER (A-Z)
INCLUDE 'dparam.for'
LOGICAL F,PUT,OBJACT,FLG
C
IF((OFLAG2(PRSO).AND.NOCHBT).EQ.0) GO TO 100
DROP=OBJACT(X) ! no check, let obj handle.
RETURN
C
100 DROP=.TRUE. ! assume wins.
X=OCAN(PRSO) ! get container.
IF(X.EQ.0) GO TO 200 ! is it inside?
IF(OADV(X).NE.WINNER) GO TO 1000 ! is he carrying con?
IF((OFLAG2(X).AND.OPENBT).NE.0) GO TO 300 ! is it open?
CALL RSPSUB(525,ODESC2(X)) ! cant reach.
RETURN
C
200 IF(OADV(PRSO).NE.WINNER) GO TO 1000 ! is he carrying obj?
300 IF(AVEHIC(WINNER).EQ.0) GO TO 400 ! is he in vehicle?
PRSI=AVEHIC(WINNER) ! yes,
F=PUT(.TRUE.) ! drop into vehicle.
PRSI=0 ! disarm parser.
RETURN ! done.
C
400 CALL NEWSTA(PRSO,0,HERE,0,0) ! drop into room.
CALL SCRUPD(OFVAL(PRSO)) ! score object.
OFVAL(PRSO)=0 ! cant be scored again.
OFLAG2(PRSO)=OFLAG2(PRSO).OR.TCHBT ! has been touched.
C
IF(OBJACT(X)) RETURN ! did it handle?
IF(PRSA.EQ.DROPW) CALL RSPEAK(528)
IF(PRSA.EQ.THROWW) CALL RSPEAK(529)
RETURN
C
1000 I=527 ! assume player.
IF(WINNER.NE.PLAYER) I=1078
CALL RSPEAK(I) ! dont have it.
RETURN
C
END
C PUT- Put verb processor
C
C Declarations
C
LOGICAL FUNCTION PUT(FLG)
IMPLICIT INTEGER (A-Z)
INCLUDE 'dparam.for'
LOGICAL QOPEN,QHERE,OBJACT,FLG,TAKE
C
C Functions and data
C
QOPEN(R)=(OFLAG2(R).AND.OPENBT).NE.0
C PUT, PAGE 2
C
IF((OFLAG2(PRSO).AND.NOCHBT).EQ.0) GO TO 100
PUT=OBJACT(X) ! no check, let obj handle.
RETURN
C
100 PUT=.FALSE.
IF((PRSO.LE.STRBIT).AND.(PRSI.LE.STRBIT)) GO TO 200
IF(.NOT.OBJACT(X)) CALL RSPEAK(560) ! star
PUT=.TRUE.
RETURN
C
200 IF(QOPEN(PRSI).OR.((OFLAG1(PRSI).AND.(DOORBT+CONTBT)).NE.0)
1.OR.((OFLAG2(PRSI).AND.VEHBT).NE.0)) GO TO 300
CALL RSPEAK(561) ! cant put in that.
RETURN
C
300 IF(QOPEN(PRSI)) GO TO 400 ! is it open?
CALL RSPEAK(562) ! no, joke
RETURN
C
400 IF(PRSO.NE.PRSI) GO TO 500 ! into itself?
CALL RSPEAK(563) ! yes, joke.
RETURN
C
500 IF(OCAN(PRSO).NE.PRSI) GO TO 600 ! already inside.
CALL RSPSB2(564,ODESC2(PRSO),ODESC2(PRSI))
PUT=.TRUE.
RETURN
C
600 IF((WEIGHR(PRSO,0)+WEIGHR(PRSI,0)+OSIZE(PRSO))
1.LE.OCAPAC(PRSI)) GO TO 700 ! not too full?
IF(PRSI.NE.AVEHIC(WINNER)) GO TO 650 ! into vehicle?
CALL RSPSUB(889,ODESC2(PRSI)) ! too full.
RETURN
C
650 CALL RSPEAK(565) ! then cant do it.
RETURN
C
C Now see if object (or its container) is in room
C
700 J=PRSO ! start search.
725 IF(QHERE(J,HERE)) GO TO 750 ! is it here?
J=OCAN(J)
IF(J.NE.0) GO TO 725 ! more to do?
GO TO 800 ! no, sch fails.
C
750 IF((PRSO.EQ.WATER).OR.(PRSO.EQ.GWATE)) GO TO 800
SVO=PRSO ! save parser.
SVI=PRSI
PRSA=TAKEW
PRSI=0
IF(.NOT.TAKE(.FALSE.)) RETURN ! take object.
PRSA=PUTW
PRSO=SVO
PRSI=SVI
GO TO 1000
C
C Now see if object is on person.
C
800 IF(OCAN(PRSO).EQ.0) GO TO 1000 ! inside?
IF(QOPEN(OCAN(PRSO))) GO TO 900 ! open?
CALL RSPSUB(566,ODESC2(PRSO)) ! lose.
RETURN
C
900 CALL SCRUPD(OFVAL(PRSO)) ! score object.
OFVAL(PRSO)=0
OFLAG2(PRSO)=OFLAG2(PRSO).OR.TCHBT ! has been touched.
CALL NEWSTA(PRSO,0,0,0,WINNER) ! temporarily on winner.
C
1000 IF(OBJACT(X)) RETURN ! no, give object a shot.
CALL NEWSTA(PRSO,2,0,PRSI,0) ! contained inside.
PUT=.TRUE.
RETURN
C
END
C VALUAC- Handles valuables/everything/possessions/bunch object
C for take, put, drop, count
C
C Declarations
C
SUBROUTINE VALUAC(V)
IMPLICIT INTEGER (A-Z)
INCLUDE 'dparam.for'
LOGICAL LIT,F,F1,TAKE,PUT,DROP,NOTHIS,NOHERE,QHERE,QBUNCH
C
C Functions and data
C
NOTHIS(R)=((SAVEP.EQ.BUNOBJ).AND.QBUNCH(R)) .OR.
1 ((OTVAL(R).LE.0).AND.((SAVEP.EQ.VALUA).OR.
2 ((SAVEP.EQ.BUNOBJ).AND.(BUNSUB.EQ.VALUA)))) .OR.
3 ((OADV(R).NE.WINNER).AND.((SAVEP.EQ.POSSE).OR.
4 ((SAVEP.EQ.BUNOBJ).AND.(BUNSUB.EQ.POSSE))))
NOHERE(R)=((AV.EQ.0).AND..NOT.QHERE(R,HERE)) .OR.
1 ((AV.NE.0).AND.(OCAN(R).NE.AV))
C VALUAC, PAGE 2
C Count
C
IF((PRSA.NE.COUNTW).OR.(PRSO.NE.POSSE)) GO TO 100
K=0
DO 50 J=1,OLNT ! count possessions.
IF(OADV(J).EQ.WINNER) K=K+1
50 CONTINUE
IF(K.EQ.1) WRITE(OUTCH,60) K
IF(K.NE.1) WRITE(OUTCH,70) K
60 FORMAT(' You have ',I1,' possession.')
70 FORMAT(' You have ',I2,' possessions.')
TELFLG=.TRUE.
RETURN
C
100 IF((PRSA.NE.COUNTW).OR.(PRSO.NE.VALUA)) GO TO 200
K=0
L=0
DO 150 J=1,OLNT ! count treasures.
IF((OADV(J).EQ.WINNER).AND.(OTVAL(J).GT.0)) K=K+1
IF((OCAN(J).EQ.TCASE).AND.(OTVAL(J).GT.0)) L=L+1
150 CONTINUE
IF(K.EQ.1) WRITE(OUTCH,160) K
IF(K.NE.1) WRITE(OUTCH,170) K
160 FORMAT(' You have ',I1,' valuable.')
170 FORMAT(' You have ',I2,' valuables.')
TELFLG=.TRUE.
IF(HERE.NE.LROOM) RETURN
IF(L.EQ.1) WRITE(OUTCH,180) L
IF(L.NE.1) WRITE(OUTCH,190) L
180 FORMAT(' Your adventure has netted ',I1,' treasure.')
190 FORMAT(' Your adventure has netted ',I2,' treasures.')
RETURN
C VALUAC, PAGE 3
C Take
C
200 SAVEP=PRSO ! save prso.
SAVEH=HERE ! save here.
F=.TRUE. ! assume no actions.
I=579 ! assume not lit.
AV=AVEHIC(WINNER) ! get vehicle.
C
IF(PRSA.NE.TAKEW) GO TO 1000 ! take?
IF(.NOT.LIT(HERE)) GO TO 4500 ! if not lit, punt.
IF((PRSO.NE.BUNOBJ).OR.(BUNSUB.NE.0)) GO TO 400 ! bunch, no except?
DO 300 I=1,BUNLNT ! loop through bunch.
PRSO=BUNVEC(I) ! get next item.
F=.FALSE.
CALL RSPSUB(580,ODESC2(PRSO))
F1=TAKE(.TRUE.)
IF(SAVEH.NE.HERE) GO TO 4500
300 CONTINUE
GO TO 4000 ! go clean up.
C
400 DO 500 PRSO=1,OLNT ! loop thru objects.
IF((((OFLAG1(PRSO).AND.TAKEBT).EQ.0).AND.
1((OFLAG2(PRSO).AND.TRYBT).EQ.0)).OR.
2((OFLAG1(PRSO).AND.VISIBT).EQ.0).OR.
3((OFLAG2(PRSO).AND.ACTRBT).NE.0).OR.
4NOTHIS(PRSO)) GO TO 500
IF(.NOT.NOHERE(PRSO)) GO TO 450 ! is it here?
J=OCAN(PRSO) ! get container.
IF((J.EQ.0).OR.(PRSO.EQ.WATER)) GO TO 500 ! in a cont?
IF(((OFLAG2(J).AND.OPENBT).EQ.0).OR.
1(NOHERE(J).AND.(OADV(J).NE.WINNER)))
2GO TO 500 ! in open cont here?
C
450 F=.FALSE.
CALL RSPSUB(580,ODESC2(PRSO))
F1=TAKE(.TRUE.)
IF(SAVEH.NE.HERE) GO TO 4500
500 CONTINUE
GO TO 4000 ! go clean up.
C VALUAC, PAGE 4
C Drop
C
1000 IF(PRSA.NE.DROPW) GO TO 2000 ! drop?
IF((PRSO.NE.BUNOBJ).OR.(BUNSUB.NE.0)) GO TO 1400 ! bunch, no except?
DO 1300 I=1,BUNLNT ! loop through bunch.
PRSO=BUNVEC(I) ! get next item.
F=.FALSE.
CALL RSPSUB(580,ODESC2(PRSO))
F1=DROP(.TRUE.)
IF(SAVEH.NE.HERE) GO TO 4500
1300 CONTINUE
GO TO 4000 ! go clean up.
C
1400 DO 1500 PRSO=1,OLNT ! loop through inventory.
IF((OADV(PRSO).NE.WINNER).OR.NOTHIS(PRSO))
1GO TO 1500
F=.FALSE.
CALL RSPSUB(580,ODESC2(PRSO))
F1=DROP(.TRUE.)
IF(SAVEH.NE.HERE) GO TO 4500
1500 CONTINUE
GO TO 4000 ! go clean up.
C VALUAC, PAGE 5
C Put
C
2000 IF(PRSA.NE.PUTW) GO TO 3000 ! put?
IF(.NOT.LIT(HERE)) GO TO 4500 ! if not lit, punt.
IF((PRSO.NE.BUNOBJ).OR.(BUNSUB.NE.0)) GO TO 2400 ! bunch, no except?
DO 2300 I=1,BUNLNT ! loop through bunch.
PRSO=BUNVEC(I) ! get next item.
F=.FALSE.
CALL RSPSUB(580,ODESC2(PRSO))
F1=PUT(.TRUE.)
IF(SAVEH.NE.HERE) GO TO 4500
2300 CONTINUE
GO TO 4000 ! go clean up.
C
2400 DO 2500 PRSO=1,OLNT ! loop thru objects.
IF(((OADV(PRSO).NE.WINNER).AND.
1(NOHERE(PRSO).OR.
2(((OFLAG1(PRSO).AND.TAKEBT).EQ.0).AND.
3 ((OFLAG2(PRSO).AND.TRYBT).EQ.0)))) .OR.
4(PRSO.EQ.PRSI).OR.NOTHIS(PRSO).OR.
5((OFLAG1(PRSO).AND.VISIBT).EQ.0)) GO TO 2500
F=.FALSE.
CALL RSPSUB(580,ODESC2(PRSO))
F1=PUT(.TRUE.)
IF(SAVEH.NE.HERE) GO TO 4500
2500 CONTINUE
GO TO 4000 ! go clean up.
C
C Wrong verb.
C
3000 I=677 ! wrong verb.
GO TO 4500
C
C Clean up.
C
4000 I=581 ! right verb, choose
IF(SAVEP.EQ.VALUA) I=582 ! nothing happened message.
4500 IF(F) CALL RSPEAK(I) ! not lit, nothing, wrong verb?
PRSO=SAVEP ! restore PRSO.
BUNSUB=0 ! cancel EXCEPT/BUT.
RETURN
END
C QBUNCH- Is object in bunch vector?
C
C Declarations
C
LOGICAL FUNCTION QBUNCH(OBJ)
IMPLICIT INTEGER (A-Z)
INCLUDE 'dparam.for'
C
IF(BUNLNT.EQ.0) GO TO 200 ! bunch vector empty?
QBUNCH=.TRUE. ! assume found.
DO 100 I=1,BUNLNT ! search bunch vector.
IF(OBJ.EQ.BUNVEC(I)) RETURN ! got one.
100 CONTINUE
200 QBUNCH=.FALSE. ! not found.
RETURN
C
END
C SAVE- Save game state
C
C Declarations
C
SUBROUTINE SAVEGM
IMPLICIT INTEGER (A-Z)
INCLUDE 'dparam.for'
C
IF(SUBLNT.EQ.0) SUBBUF='DSAVE.DAT'
OPEN (UNIT=1,FILE=SUBBUF,ACCESS='SEQUENTIAL',
1STATUS='UNKNOWN',FORM='UNFORMATTED',ERR=100)
C
CALL GTTIME(I) ! get time.
WRITE(1) VMAJ,VMIN
WRITE(1) WINNER,HERE,THFPOS,TELFLG,THFFLG,THFACT,
1SWDACT,SWDSTA,CPVEC
WRITE(1) I,MOVES,DEATHS,RWSCOR,EGSCOR,MXLOAD,
1LTSHFT,BLOC,MUNGRM,HS,FROMDR,SCOLRM,SCOLAC
WRITE(1) ODESC1,ODESC2,OFLAG1,OFLAG2,OFVAL,OTVAL,
1OSIZE,OCAPAC,OROOM,OADV,OCAN
WRITE(1) RDESC1,RVAL,RFLAG,TRAVEL
WRITE(1) AROOM,ASCORE,AVEHIC,ASTREN,AFLAG
WRITE(1) FLAGS,SWITCH,VPROB,CFLAG,CTICK,CCNCEL
C
CALL RSPEAK(597)
CLOSE (UNIT=1)
RETURN
C
100 CALL RSPEAK(598) ! cant do it.
RETURN
END
C RESTORE- Restore game state
C
C Declarations
C
SUBROUTINE RSTRGM
IMPLICIT INTEGER (A-Z)
INCLUDE 'dparam.for'
C
IF(SUBLNT.EQ.0) SUBBUF='DSAVE.DAT'
OPEN (UNIT=1,FILE=SUBBUF,ACCESS='SEQUENTIAL',
1STATUS='OLD',MODE='READ',FORM='UNFORMATTED',ERR=100)
C
READ(1) I,J
IF((I.NE.VMAJ).OR.(J.NE.VMIN)) GO TO 200
C
READ(1) WINNER,HERE,THFPOS,TELFLG,THFFLG,THFACT,
1SWDACT,SWDSTA,CPVEC
READ(1) PLTIME,MOVES,DEATHS,RWSCOR,EGSCOR,MXLOAD,
1LTSHFT,BLOC,MUNGRM,HS,FROMDR,SCOLRM,SCOLAC
READ(1) ODESC1,ODESC2,OFLAG1,OFLAG2,OFVAL,OTVAL,
1OSIZE,OCAPAC,OROOM,OADV,OCAN
READ(1) RDESC1,RVAL,RFLAG,TRAVEL
READ(1) AROOM,ASCORE,AVEHIC,ASTREN,AFLAG
READ(1) FLAGS,SWITCH,VPROB,CFLAG,CTICK,CCNCEL
C
CALL RSPEAK(599)
CLOSE (UNIT=1)
RETURN
C
100 CALL RSPEAK(598) ! cant do it.
RETURN
C
200 CALL RSPEAK(600) ! obsolete version
CLOSE (UNIT=1)
RETURN
END
C WALK- Move in specified direction
C
C Declarations
C
LOGICAL FUNCTION WALK(X)
IMPLICIT INTEGER (A-Z)
INCLUDE 'dparam.for'
LOGICAL FINDXT,QOPEN,LIT,PROB,MOVETO,RMDESC
C
C Functions and data
C
QOPEN(O)=(OFLAG2(O).AND.OPENBT).NE.0
C WALK, PAGE 2
C
WALK=.TRUE. ! assume wins.
IF((WINNER.NE.PLAYER).OR.LIT(HERE).OR.PROB(25,25))
1GO TO 500
IF(.NOT.FINDXT(PRSO,HERE)) GO TO 450 ! invalid exit? grue!
GO TO (400,200,100,300),XTYPE ! decode exit type.
CALL BUG(9,XTYPE)
C
100 IF(CXAPPL(XACTIO).NE.0) GO TO 400 ! cexit... returned room?
IF(FLAGS(XFLAG)) GO TO 400 ! no, flag on?
200 CALL JIGSUP(523) ! bad exit, grue!
RETURN
C
300 IF(CXAPPL(XACTIO).NE.0) GO TO 400 ! door... returned room?
IF(QOPEN(XOBJ)) GO TO 400 ! no, door open?
CALL JIGSUP(523) ! bad exit, grue!
RETURN
C
400 IF(LIT(XROOM1)) GO TO 900 ! valid room, is it lit?
450 CALL JIGSUP(522) ! no, grue!
RETURN
C
C Room is lit, or winner is not player (no grue).
C
500 IF(FINDXT(PRSO,HERE)) GO TO 550 ! exit exist?
525 XSTRNG=678 ! assume wall.
IF(PRSO.EQ.XUP) XSTRNG=679 ! if up, cant.
IF(PRSO.EQ.XDOWN) XSTRNG=680 ! if down, cant.
IF(((RFLAG(HERE).AND.RNWALL).NE.0).AND.(WINNER.EQ.PLAYER))
1XSTRNG=524 ! no wall for player.
CALL RSPEAK(XSTRNG)
PRSCON=0 ! stop cmd stream.
RETURN
C
550 GO TO (900,600,700,800),XTYPE ! branch on exit type.
CALL BUG(9,XTYPE)
C
700 IF(CXAPPL(XACTIO).NE.0) GO TO 900 ! cexit... returned room?
IF(FLAGS(XFLAG)) GO TO 900 ! no, flag on?
600 IF(XSTRNG.EQ.0) GO TO 525 ! if no reason, use std.
CALL RSPEAK(XSTRNG) ! deny exit.
PRSCON=0 ! stop cmd stream.
RETURN
C
800 IF(CXAPPL(XACTIO).NE.0) GO TO 900 ! door... returned room?
IF(QOPEN(XOBJ)) GO TO 900 ! no, door open?
IF(XSTRNG.EQ.0) XSTRNG=525 ! if no reason, use std.
CALL RSPSUB(XSTRNG,ODESC2(XOBJ))
PRSCON=0 ! stop cmd stream.
RETURN
C
900 WALK=MOVETO(XROOM1,WINNER) ! move to room.
IF(WALK) WALK=RMDESC(0) ! describe room.
RETURN
END
C CXAPPL- Conditional exit processors
C
C Declarations
C
INTEGER FUNCTION CXAPPL(RI)
IMPLICIT INTEGER (A-Z)
INCLUDE 'dparam.for'
C
CXAPPL=0 ! no return.
IF(RI.EQ.0) RETURN ! if no action, done.
GO TO (1000,2000,3000,4000,5000,6000,7000,8000,
19000,10000,11000,12000,13000,14000,15000),RI
CALL BUG(5,RI)
C CXAPPL, PAGE 2
C
C C1- Coffin-cure
C
1000 EGYPTF=OADV(COFFI).NE.WINNER ! t if no coffin.
RETURN
C
C C2- Carousel exit
C C5- Carousel out
C
2000 IF(CAROFF) RETURN ! if flipped, nothing.
2500 CALL RSPEAK(121) ! can't tell directions.
5000 I=XELNT(XCOND)*RND(8) ! choose random exit.
XROOM1=(TRAVEL(REXIT(HERE)+I)).AND.XRMASK
CXAPPL=XROOM1 ! return exit.
RETURN
C
C C3- Chimney function
C
3000 LITLDF=.FALSE. ! assume heavy load.
IF(DEADF) GO TO 3300 ! if dead, always ok.
J=0
DO 3100 I=1,OLNT ! count objects.
IF(OADV(I).EQ.WINNER) J=J+1
3100 CONTINUE
C
IF(J.GT.2) RETURN ! carrying too much?
IF(J.NE.0) GO TO 3200 ! carrying too little?
XSTRNG=890 ! bad idea.
RETURN
C
3200 IF(OADV(LAMP).EQ.WINNER) GO TO 3300 ! no lamp?
XSTRNG=446 ! bad idea.
RETURN
C
3300 LITLDF=.TRUE. ! he can do it.
IF((OFLAG2(DOOR).AND.OPENBT).EQ.0)
1OFLAG2(DOOR)=OFLAG2(DOOR).AND. .NOT.TCHBT
RETURN
C
C C4- Frobozz flag (Magnet Room, fake exit)
C C6- Frobozz flag (Magnet Room, real exit)
C
4000 IF(CAROFF) GO TO 2500 ! if flipped, go spin.
FROBZF=.FALSE. ! otherwise, not an exit.
RETURN
C
6000 IF(CAROFF) GO TO 2500 ! if flipped, go spin.
FROBZF=.TRUE. ! otherwise, an exit.
RETURN
C CXAPPL, PAGE 3
C
C C7- Frobozz flag (bank alarm)
C
7000 FROBZF=.FALSE. ! assume fails.
J=BILLS ! check for bills.
7100 IF(OADV(J).EQ.WINNER) RETURN ! winner's got it, fail.
J=OCAN(J) ! get container.
IF(J.NE.0) GO TO 7100 ! if inside, loop
J=PORTR ! check for portrait.
7200 IF(OADV(J).EQ.WINNER) RETURN ! winner's got it, fail.
J=OCAN(J) ! get container.
IF(J.NE.0) GO TO 7200 ! if inside, loop
FROBZF=.TRUE. ! wins.
RETURN
C
C C8- Frobozz flag (MRGO)
C
8000 FROBZF=.FALSE. ! assume cant move.
IF(MLOC.NE.XROOM1) GO TO 8100 ! mirror in way?
IF((PRSO.EQ.XNORTH).OR.(PRSO.EQ.XSOUTH)) GO TO 8200
IF(MOD(MDIR,180).NE.0) GO TO 8300 ! mirror must be n-s.
XROOM1=((XROOM1-MRA)*2)+MRAE ! calc east room.
IF(PRSO.GT.XSOUTH) XROOM1=XROOM1+1 ! if sw/nw, calc west.
8100 CXAPPL=XROOM1
RETURN
C
8200 XSTRNG=814 ! assume struc blocks.
IF(MOD(MDIR,180).EQ.0) RETURN ! if mirror n-s, done.
8300 LDIR=MDIR ! see which mirror.
IF(PRSO.EQ.XSOUTH) LDIR=180
XSTRNG=815 ! mirror blocks.
IF(((LDIR.GT.180).AND..NOT.MR1F).OR.
1 ((LDIR.LT.180).AND..NOT.MR2F)) XSTRNG=816 ! mirror broken.
RETURN
C
C C9- Frobozz flag (MIRIN)
C
9000 IF(MRHERE(HERE).NE.1) GO TO 9100 ! mirror 1 here?
IF(MR1F) XSTRNG=805 ! see if broken.
FROBZF=MROPNF ! enter if open.
RETURN
C
9100 FROBZF=.FALSE. ! not here,
XSTRNG=817 ! lose.
RETURN
C CXAPPL, PAGE 4
C
C C10- Frobozz flag (mirror exit)
C
10000 FROBZF=.FALSE. ! assume cant.
LDIR=((PRSO-XNORTH)/XNORTH)*45 ! xlate dir to degrees.
IF(.NOT.MROPNF .OR.
1((MOD(MDIR+270,360).NE.LDIR).AND.(PRSO.NE.XEXIT)))
2GO TO 10200 ! exit via mirror?
XROOM1=((MLOC-MRA)*2)+MRAE+1-(MDIR/180) ! assume e-w exit.
IF(MOD(MDIR,180).EQ.0) GO TO 10100 ! if n-s, ok.
XROOM1=MLOC+1 ! assume n exit.
IF(MDIR.GT.180) XROOM1=MLOC-1 ! if south.
10100 CXAPPL=XROOM1
RETURN
C
10200 IF(.NOT.WDOPNF .OR.
1((MOD(MDIR+180,360).NE.LDIR).AND.(PRSO.NE.XEXIT)))
2RETURN ! exit via open door?
XROOM1=MLOC+1 ! assume n.
IF(MDIR.EQ.0) XROOM1=MLOC-1 ! if s.
CALL RSPEAK(818) ! close door.
WDOPNF=.FALSE.
CXAPPL=XROOM1
RETURN
C
C C11- Maybe door. Normal message is that door is closed.
C But if LCELL.NE.4, door isn't there.
C
11000 IF(LCELL.NE.4) XSTRNG=678 ! set up msg.
RETURN
C
C C12- Frobozz flag (Puzzle Room main entrance)
C
12000 CPHERE=10 ! set substate.
FROBZF=CPVEC(CPHERE).EQ.0 ! enter if not blocked.
RETURN
C
C C13- CPOUTF (Puzzle Room size entrance)
C
13000 CPHERE=52 ! set substate.
RETURN
C CXAPPL, PAGE 5
C
C C14- Frobozz flag (Puzzle Room transitions)
C
14000 FROBZF=.FALSE. ! asssume lose.
IF(PRSO.NE.XUP) GO TO 14100 ! up?
IF(CPHERE.NE.10) RETURN ! at exit?
XSTRNG=881 ! assume no ladder.
IF(CPVEC(CPHERE+1).NE.-2) RETURN ! ladder here?
CALL RSPEAK(882) ! you win.
RFLAG(CPUZZ)=RFLAG(CPUZZ).AND..NOT.RSEEN ! reset seen.
FROBZF=.TRUE. ! let him out.
RETURN
C
14100 IF((CPHERE.NE.52).OR.(PRSO.NE.XWEST).OR..NOT.CPOUTF)
1GO TO 14200 ! w exit at door?
RFLAG(CPUZZ)=RFLAG(CPUZZ).AND..NOT.RSEEN ! reset seen.
FROBZF=.TRUE. ! yes, let him out.
RETURN
C
14200 IF((CPHERE.NE.52).OR.(PRSO.NE.XWEST)) GO TO 14250
XSTRNG=932 ! door in way.
RETURN
C
14250 DO 14300 I=1,16,2 ! locate exit.
IF(PRSO.EQ.CPDR(I)) GO TO 14400
14300 CONTINUE
RETURN ! no such exit.
C
14400 J=CPDR(I+1) ! get directional offset.
NXT=CPHERE+J ! get next state.
K=8 ! get orthogonal dir.
IF(J.LT.0) K=-8
IF((((IABS(J).EQ.1).OR.(IABS(J).EQ.8)).OR.
1 ((CPVEC(CPHERE+K).EQ.0).OR.(CPVEC(NXT-K).EQ.0))).AND.
2 (CPVEC(NXT).EQ.0)) GO TO 14500 ! cant do it?
RETURN
C
14500 CALL CPGOTO(NXT) ! move to state.
XROOM1=CPUZZ ! stay in room.
CXAPPL=XROOM1
RETURN
C
C C15- Frobozz flag (slide exit)
C
15000 FROBZF=.TRUE. ! works.
IF((TTIE.EQ.0).OR.DEADF) RETURN ! if no rope or dead, cellar.
IF(OROOM(TTIE).NE.HERE) RETURN ! if rope elsewhere, cellar.
CALL RSPEAK(1014) ! slippery.
CFLAG(CEVSLI)=.TRUE. ! turn on slide clock.
CTICK(CEVSLI)=MAX0(2,100/WEIGHR(0,WINNER))
XROOM1=SLID1 ! on the ropes.
CXAPPL=XROOM1
RETURN
C
END